home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS03.ADF / ABasiCprogs / ncards.bas < prev    next >
BASIC Source File  |  1986-04-02  |  11KB  |  342 lines
  1. 5     t=0
  2. 10    dv=570:dim card%(dv),sm%(18),sms%(4,18),lg%(23),lgs%(4,22)
  3. 45    peno 15
  4. 46    outline 1
  5. 47    drawmode 0
  6. 50    pena 2:box(50,50;110,120),1
  7. 51    pena 0:draw(50,50):draw(110,50):draw(50,120):draw(110,120)
  8. 53    sshape(50,50;111,121),card%
  9. 55    for x= 0 to 1:read pat%(x):next
  10. 60    pattern 2, pat%()
  11. 70    data &b1111000011110000,&b0000111100001111
  12. 75    gshape(100,100),card%
  13. 76    pena 4:box(105,105;155,165)
  14. 77    peno 1:circle(130,135),22,.5:circle(130,135),15,1.5:rem draw(116,126 to 144,145)
  15. 78    pena 1:penb 4:paint(110,110),1
  16. 80    dim card53%(570)
  17. 85    sshape(100,100;161,171),card53%
  18. 90    pattern 0,off%
  19. 91    drawmode 1
  20. 105   rgb 0,15,15,15
  21. 106   outline 0
  22. 107   scnclr
  23. 110   pena 2:draw(50,50):pena 4
  24. 115   gosub 900
  25. 120   rem draw small heart
  26. 121   draw(52,50 to 53,50):draw(55,50 to 56,50)
  27. 122   draw(51,51 to 57,51)
  28. 123   draw(51,52 to 57,52)
  29. 124   draw(51,53 to 57,53)
  30. 125   draw(52,54 to 56,54)
  31. 126   draw(53,55 to 55,55)
  32. 127   draw(54,56)
  33. 129   sshape(50,50;58,57),sm%
  34. 130   for x=0 to 18:sms%(1,x)=sm%(x):next
  35. 131   gosub 900
  36. 132   draw(52,50 to 53,50):draw(57,50 to 58,50)
  37. 133   draw(to 59,51 to 60,52 to 60,54 to 55,59)
  38. 134   draw(to 50,54 to 50,52 to 51,51 to 52,50 to 53,50 to 54,51 )
  39. 135   draw(to 55,52 to 56,51 to 57,50)
  40. 136   paint (55,55),1
  41. 138   sshape (50,50;61,60),lg%
  42. 140   for x= 0 to 22:lgs%(1,x)=lg%(x):next
  43. 200   rem draw clubs
  44. 210   gosub 900:pena 1
  45. 220   draw(53,50 to 54,50)
  46. 221   draw(53,51 to 54,51)
  47. 222   draw(51,52 to 52,52)
  48. 223   draw(55,52 to 56,52)
  49. 224   draw(51,53 to 52,53)
  50. 225   draw(55,53 to 56,53)
  51. 226   draw(53,54 to 54,54)
  52. 227   draw(53,55 to 54,55)
  53. 228   draw(52,56 to 55,56)
  54. 230   sshape (50,50;57,57),sm%
  55. 235   for x=0 to 18:sms%(2,x)=sm%(x):next
  56. 240   gosub 900:pena 1
  57. 241   draw (55,50 to 55,59)
  58. 242   draw(50,54 to 60,54)
  59. 243   draw(53,59 to 58,59)
  60. 244   draw(54,51 to 56,51)
  61. 245   draw(54,52 to 56,52)
  62. 246   draw(51,53 to 59,53)
  63. 247   draw(51,55 to 52,55)
  64. 248   draw(58,53 to 59,53)
  65. 249   draw(58,55 to 59,55)
  66. 250   draw(54,56 to 56,56)
  67. 251   draw(54,57 to 56,57)
  68. 252   draw(54,58 to 56,58)
  69. 256   sshape(50,50;61,60),lg%
  70. 257   for x%= 0 to 22:lgs%(2,x%)=lg%(x%):next
  71. 300   rem diamonds
  72. 310   gosub 900:pena 4
  73. 320   draw(54,50 to 57,53 to 54,56 to 51,53 to 54,50)
  74. 321   pena 4:paint (54,55) ,1
  75. 326   sshape(50, 50;58,57),sm%
  76. 327   for x=0 to 18:sms%(3,x)= sm%(x):next
  77. 330   gosub 900:pena 4
  78. 331   draw(55,50 to 60,55 to 55,60 to 50,55 to 55,50)
  79. 332   paint(55,55),1
  80. 334   sshape(50,50;61,61),lg%
  81. 335   for x=0 to 22:lgs%(3,x)= lg%(x):next
  82. 400   rem spades
  83. 410   gosub 900:pena 1
  84. 420   draw(54,50)
  85. 421   draw(53,51 to 55,51)
  86. 422   draw(52,52 to 56,52)
  87. 423   draw(51,53 to 57,53)
  88. 424   draw(51,54 to 57,54)
  89. 425   draw(53,55 to 55,55)
  90. 426   draw(52,56 to 56,56)
  91. 427   sshape(50,50;58,57),sm%
  92. 428   for x=0 to 18:sms%(4,x)=sm%(x):next
  93. 430   gosub 900:pena 1
  94. 431   draw(55,50 to 60,55 to 60,56 to 59,57 to 51,57 to 50,56 to 50,55 to 55,50)
  95. 432   draw(54,58 to 56,58)
  96. 433   draw(52,59 to 58,59)
  97. 434   paint(55,55),1
  98. 436   sshape (50,50;61,60),lg%
  99. 437   for x=0 to 22:lgs%(4,x)=lg%(x):next
  100. 888   t=0
  101. 899   goto 1000
  102. 900   pena 2:box(25,25;100,100),1:pena 4:return
  103. 1000  rem ***** draw cards *****
  104. 1005  gosub 8000
  105. 1010  scnclr
  106. 1015  x=100:y=100
  107. 1020  gshape(x,y),card%
  108. 1025  graphic 1
  109. 1030  penb 2
  110. 1035  pena r
  111. 1039  rem *** aces ***
  112. 1040  ? at (x+2,y+9);"A"
  113. 1050  gshape(x+1,y+11),sm%
  114. 1051  a=2:d=2
  115. 1055  b=10:e=18
  116. 1060  gosub 9000
  117. 1065  gshape(x+25,y+32),lg%
  118. 1070  if t= 0 then dim card1%(570):sshape(100,100;161,171),card1%
  119. 1072  if t=1 then dim card14%(570):sshape(100,100;161,171),card14%
  120. 1073  if t=2 then dim card27%(570):sshape(100,100;161,171),card27%
  121. 1074  if t=3 then dim card40%(570):sshape(100,100;161,171),card40%
  122. 1080  gshape(x,y),card%
  123. 1085  pena r:?at(x+2,y+9);"2"
  124. 1090  gosub 9010
  125. 1095  gshape(x+25,y+10),lg%
  126. 1096  a=2:b=8
  127. 1097  d=2:e=17
  128. 1098  gosub 9000
  129. 1099  a=20:d=10
  130. 1100  b=35:e=20
  131. 1105  gosub 9000
  132. 1110  if t=0 then dim card2%(570):sshape(100,100;161,171),card2%
  133. 1111  if t=1 then dim card15%(570):sshape(100,100;161,171),card15%
  134. 1112  if t=2 then dim card28%(570):sshape(100,100;161,171),card28%
  135. 1113  if t=3 then dim card41%(570):sshape(100,100;161,171),card41%
  136. 1120  rem three on two
  137. 1125  pena r:?at(x+2,y+9);"3"
  138. 1130  gosub 9050
  139. 1135  gshape(x+25,y+31),lg%
  140. 1140  if t=0 then dim card3%(570):sshape(100,100;161,171),card3%
  141. 1141  if t=1 then dim card16%(570):sshape(100,100;161,171),card16%
  142. 1142  if t=2 then dim card29%(570):sshape(100,100;161,171),card29%
  143. 1143  if t=3 then dim card42%(570):sshape(100,100;161,171),card42%
  144. 1150  rem  four
  145. 1155  gosub 9020
  146. 1160  pena r:?at(x+2,y+9);"4"
  147. 1165  gosub 9010
  148. 1170  gshape(x+15,y+10),lg%
  149. 1175  gshape(x+35,y+10),lg%
  150. 1176  a=2:b=8:d=2:e=20:gosub 9000
  151. 1177  a=15:b=25:d=10:e=20:gosub 9000
  152. 1178  a=35:b=45:gosub 9000
  153. 1185  if t=0 then dim card4%(570):sshape(100,100;161,171),card4%
  154. 1186  if t=1 then dim card17%(570):sshape(100,100;161,171),card17%
  155. 1187  if t=2 then dim card30%(570):sshape(100,100;161,171),card30%
  156. 1188  if t=3 then dim card43%(570):sshape(100,100;161,171),card43%
  157. 1195  rem five on four
  158. 1200  pena r:?at(x+2,y+9);"5"
  159. 1205  gosub 9050
  160. 1210  gshape(x+25,y+32),lg%
  161. 1215  if t=0 then dim card5%(570):sshape(100,100;161,171),card5%
  162. 1216  if t=1 then dim card18%(570):sshape(100,100;161,171),card18%
  163. 1217  if t=2 then dim card31%(570):sshape(100,100;161,171),card31%
  164. 1218  if t=3 then dim card44%(570):sshape(100,100;161,171),card44%
  165. 1225  rem six on five
  166. 1230  pena r:?at(x+2,y+9);"6"
  167. 1235  outline 0:pena 2:box(x+25,y+32;x+35,y+42),1
  168. 1240  outline 1:gosub 9050
  169. 1245  gshape(x+15,y+32),lg%
  170. 1250  gshape(x+35,y+32),lg%
  171. 1255  if t=0 then dim card6%(570):sshape(100,100;161,171),card6%
  172. 1256  if t=1 then dim card19%(570):sshape(100,100;161,171),card19%
  173. 1257  if t=2 then dim card32%(570):sshape(100,100;161,171),card32%
  174. 1258  if t=3 then dim card45%(570):sshape(100,100;161,171),card45%
  175. 1265  rem seven on six
  176. 1270  pena r:?at(x+2,y+9);"7"
  177. 1275  gosub 9050
  178. 1280  gshape(x+25,y+20),lg%
  179. 1285  if t=0 then dim card7%(570):sshape(100,100;161,171),card7%
  180. 1286  if t=1 then dim card20%(570):sshape(100,100;161,171),card20%
  181. 1287  if t=2 then dim card33%(570):sshape(100,100;161,171),card33%
  182. 1288  if t=3 then dim card46%(570):sshape(100,100;161,171),card46%
  183. 1295  rem eight
  184. 1300  gosub 9020
  185. 1305  pena r:?at(x+2,y+9);"8"
  186. 1310  gosub 9010
  187. 1315  gshape(x+15,y+10),lg%
  188. 1320  gshape(x+35,y+10),lg%
  189. 1325  gshape(x+15,y+24),lg%
  190. 1330  gshape(x+35,y+24),lg%
  191. 1331  a=2:b=8:d=2:e=20
  192. 1332  gosub 9000
  193. 1333  a=15:b=25:d=10:e=34
  194. 1334  gosub 9000
  195. 1335  a=35:b=45
  196. 1336  gosub 9000
  197. 1340  if t=0 then dim card8%(570):sshape(100,100;161,171),card8%
  198. 1341  if t=1 then dim card21%(570):sshape(100,100;161,171),card21%
  199. 1342  if t=2 then dim card34%(570):sshape(100,100;161,171),card34%
  200. 1343  if t=3 then dim card47%(570):sshape(100,100;161,171),card47%
  201. 1350  rem nine on eight
  202. 1355  pena r:?at(x+2,y+9);"9"
  203. 1360  gosub 9050
  204. 1365  gshape(x+25,y+16),lg%
  205. 1370  if t=0 then dim card9%(570):sshape(100,100;161,171),card9%
  206. 1371  if t=1 then dim card22%(570):sshape(100,100;161,171),card22%
  207. 1372  if t=2 then dim card35%(570):sshape(100,100;161,171),card35%
  208. 1373  if t=3 then dim card48%(570):sshape(100,100;161,171),card48%
  209. 1380  rem ten on nine
  210. 1385  pena r:?at(x+1,y+9);"10"
  211. 1386  a=2:b=15
  212. 1387  d=2:e=10
  213. 1388  gosub 9000
  214. 1389  a=25:b=35
  215. 1390  d=15:e=30
  216. 1391  gosub 9000
  217. 1395  if t=0 then dim card10%(570):sshape(100,100;161,171),card10%
  218. 1396  if t=1 then dim card23%(570):sshape(100,100;161,171),card23%
  219. 1397  if t=2 then dim card36%(570):sshape(100,100;161,171),card36%
  220. 1398  if t=3 then dim card49%(570):sshape(100,100;161,171),card49%
  221. 1400  '
  222. 1405  rem jack
  223. 1410  gosub 9020
  224. 1415  pena r:?at(x+1,y+9);"J"
  225. 1420  gosub 9010
  226. 1425  pena 1:draw(x+10,y+35 to x+10,y+10 to x+50,y+10 to x+50,y+35)
  227. 1426  gshape(x+14,y+14),lg%
  228. 1427  a=2:b=8:d=2:e=20:gosub 9000
  229. 1428  a=9:b=11:d=9:e=35:gosub 9000
  230. 1429  a=12:b=24:e=25:gosub 9000
  231. 1430  a=24:b=50:d=10:e=11:gosub 9000
  232. 1431  a=50:b=51:e=35:gosub 9000
  233. 1435  if t=0 then dim card11%(570):sshape(100,100;161,171),card11%
  234. 1436  if t=1 then dim card24%(570):sshape(100,100;161,171),card24%
  235. 1437  if t=2 then dim card37%(570):sshape(100,100;161,171),card37%
  236. 1438  if t=3 then dim card50%(570):sshape(100,100;161,171),card50%
  237. 1445  rem queen
  238. 1450  pena r:?at(x+2,y+9);"Q"
  239. 1455  gosub 9050
  240. 1461  if t=0 then dim card12%(570):sshape(100,100;161,171),card12%
  241. 1462  if t=1 then dim card25%(570):sshape(100,100;161,171),card25%
  242. 1463  if t=2 then dim card38%(570):sshape(100,100;161,171),card38%
  243. 1464  if t=3 then dim card51%(570):sshape(100,100;161,171),card51%
  244. 1470  rem king
  245. 1475  pena r:?at(x+2,y+9);"K"
  246. 1480  gosub 9050
  247. 1485  if t=0 then dim card13%(570):sshape(100,100;161,171),card13%
  248. 1486  if t=1 then dim card26%(570):sshape(100,100;161,171),card26%
  249. 1487  if t=2 then dim card39%(570):sshape(100,100;161,171),card39%
  250. 1488  if t=3 then dim card52%(570):sshape(100,100;161,171),card52%
  251. 1495  t=t+1
  252. 1496  if t>3 then 1498
  253. 1497  goto 1000
  254. 1498  chain "dice1",0,all
  255. 7000  rem
  256. 7005  scnclr
  257. 7010  x=00:y=50
  258. 7015  gshape(x,y),card1%
  259. 7020  x=x+20
  260. 7030  gosub 8500
  261. 7040  gshape(x,y),card2%
  262. 7050  x=x+20
  263. 7060  gosub 8500
  264. 7070  gshape(x,y),card3%
  265. 7080  x=x+20
  266. 7090  gosub 8500
  267. 7100  gshape(x,y),card4%
  268. 7110  x=x+20
  269. 7120  gosub 8500
  270. 7130  gshape(x,y),card5%
  271. 7140  x=x+20
  272. 7150  gosub 8500
  273. 7160  gshape(x,y),card6%
  274. 7170  x=x+20
  275. 7180  gosub 8500
  276. 7190  gshape(x,y),card7%
  277. 7200  x=x+20
  278. 7210  gosub 8500
  279. 7220  gshape(x,y),card8%
  280. 7230  x=x+20
  281. 7240  gosub 8500
  282. 7250  gshape(x,y),card9%
  283. 7260  x=x+20
  284. 7270  gosub 8500
  285. 7280  gshape(x,y),card10%
  286. 7290  x=x+20
  287. 7300  gosub 8500
  288. 7310  gshape(x,y),card11%
  289. 7320  x=x+20
  290. 7330  gosub 8500
  291. 7340  gshape(x,y),card12%
  292. 7350  x=x+20
  293. 7360  gosub 8500
  294. 7370  gshape(x,y),card13%
  295. 8000  rem
  296. 8001  if t=0 then 8010
  297. 8002  if t=1 then 8020
  298. 8003  if t=2 then 8030
  299. 8004  if t=3 then 8040 
  300. 8005  if t>3 then end
  301. 8010  for x=0 to 18:sm%(x)=sms%(1,x):next
  302. 8011  for x=0 to 22:lg%(x)=lgs%(1,x):next
  303. 8012  r=4:rem pen color
  304. 8015  goto 1010
  305. 8020  for x=0 to 18:sm%(x)=sms%(2,x):next
  306. 8021  for x=0 to 22:lg%(x)=lgs%(2,x):next
  307. 8022  r=1
  308. 8025  goto 1010
  309. 8030  for x=0 to 18:sm%(x)=sms%(3,X):next
  310. 8031  for x=0 to 22:lg%(x)=lgs%(3,x):next
  311. 8032  r=4
  312. 8035  goto 1010
  313. 8040  for x=0 to 18:sm%(x)=sms%(4,x):next
  314. 8041  for x=0 to 22:lg%(x)=lgs%(4,x):next
  315. 8042  r=1
  316. 8045  goto 1010
  317. 8500  for t= 1 to 2000:next:return
  318. 8999  stop
  319. 9000  rem *** routine for copy left top to right bottom
  320. 9001  for ac= a to b: rem across
  321. 9002  for dn= d to e: rem down
  322. 9003  n= pixel (x+ac,y+dn):pena n
  323. 9004  draw(x+60-ac,y+70-dn)
  324. 9005  next dn:next ac
  325. 9006  return
  326. 9010  gshape(x+1,y+11),sm%:return: rem small shape to top left
  327. 9020  rem ** print blank card **
  328. 9021  gshape(x,y),card%:return
  329. 9022  rem
  330. 9050  rem routine for number top to bottom only
  331. 9051  for a= 0 to 10
  332. 9052  for d= 0 to 10
  333. 9053  n= pixel (x+a,y+d):pena n
  334. 9054  draw(x+60-a,y+70-d)
  335. 9055  next d:next a
  336. 9056  return
  337. 9057  rem
  338. 10000 rem
  339. 10010 get a$
  340. 10020 if a$= "q" then return
  341. 10030 if a$="c" then input "color";n:pena n:goto 10020
  342.